home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / faq / wdj0597.zip / MACK.ZIP / FILETIME.BAS
BASIC Source File  |  1996-11-04  |  3KB  |  78 lines
  1. Option Explicit
  2.  
  3. Private Const DayBias# = 109205#
  4. '
  5. ' Bias for VB Dates -
  6. ' Derived from Abs(CDbl(#01-01-1601#)), the offset between
  7. ' Day Zero for VB dates and Day Zero for Win32 dates
  8.  
  9. Private Const mSPerDay# = 86400000#
  10. '
  11. ' Milliseconds per day -
  12. ' Derived from 60 * 60 * 24 * 10000000 / 10000,
  13. ' which is the number of seconds per day times the number
  14. ' of 100 nanosecond ticks per second, and adjusted
  15. ' by the natural .0001 scaling of Currency variables.
  16.  
  17. Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
  18.    (FT As Currency, LFT As Currency) As Boolean
  19.  
  20. Private Declare Function LocalFileTimeToFileTime Lib "kernel32" _
  21.    (LFT As Currency, FT As Currency) As Boolean
  22.  
  23. Public Function DateFromFILETIME(UTCTime As Currency) As Date
  24.    '
  25.    ' Converts a 64-bit Win32 FILETIME, stored in
  26.    '  and scaled by a Currency variable, into a VB
  27.    '  Date variable.
  28.  
  29.    Dim LocalTime As Currency
  30.  
  31.    ' First convert the UTC FILETIME to a locally-biased time.
  32.    ' If this function fails (returns False), raise an error.
  33.    '
  34.    If FileTimeToLocalFileTime(UTCTime, LocalTime) Then
  35.    '
  36.    ' Divide the result by the number of milliseconds in
  37.    '  one day (it's already scaled by 1:10000 because it's
  38.    '  stored in a scaled integer as a Currency variable).
  39.    ' This gives the number of whole days, plus a fraction,
  40.    '  since Jan 1, 1601.  Then subtract the number of days
  41.    '  between that date and VB's base date of Dec 30, 1899.
  42.  
  43.       DateFromFILETIME = CDate((LocalTime / mSPerDay) - DayBias)
  44.    Else
  45.       Err.Raise 5  'Invalid Procedure Call
  46.    End If
  47.  
  48. End Function 'DateFromFILETIME
  49.  
  50.  
  51. Public Function DateToFILETIME(Adate As Double) As Currency
  52.    '
  53.    ' Converts a VB date (coerced to Double by this call)
  54.    '  into a 64-bit Win32 FILETIME, using a Currency
  55.    '  variable to hold and scale the 64-bit integer
  56.  
  57.    Dim UTCTime As Currency, LocalTime As Currency
  58.  
  59.    ' Add to the VB date, the number of days between VB's
  60.    '  base date of Dec 30, 1899 and the Win32 base date
  61.    '  of Jan 1, 1601.  Multiply the result by the number of
  62.    '  milliseconds per day and store the result in a Currency
  63.    '  variable.  Currency is scaled by 1:10000, so when Win32
  64.    '  uses the FILETIME, it effectively multiplies it by that.
  65.    '
  66.    LocalTime = CCur((Adate + DayBias) * mSPerDay)
  67.  
  68.    ' Next convert the locally-biased FILETIME into UTC.
  69.    ' If this API call fails (returns False), raise an error.
  70.    '
  71.    If LocalFileTimeToFileTime(LocalTime, UTCTime) Then
  72.       DateToFILETIME = UTCTime
  73.    Else
  74.       Err.Raise 5  'Invalid Procedure Call
  75.    End If
  76.  
  77. End Function 'DateToFILETIME
  78.